home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.26 / druckyv2.4 / druckyv2.4.p < prev    next >
Text File  |  1995-04-23  |  20KB  |  688 lines
  1. Program printV2_4;
  2.  
  3. { Druckeransteuerungsprogramm                                }
  4. { Sprache: Kickpascal V1.05,V2.10  & 2.12 von Maxon Computer }
  5. { Programmierer: Michael Klein                               }
  6. {                Am Wasserturm 6                             }
  7. {                67346 Speyer                                }
  8. {                                                            }
  9. { Programmiert vom 10.04.91 bis zum 06.02.1994               }
  10.  
  11.  
  12. FROM mytools USES filereq;
  13. FROM mytools USES mousepos;
  14.              USES graphics;
  15.  
  16. {$ include 'exec.lib',
  17.            'Workbench/icon.h',
  18.            'dos.lib',
  19.            'Workbench/startup.h',
  20.            'icon.lib' }
  21.  
  22. CONST max=256;
  23.       version='$VER ROGERDAT Version 2.4 Rev.20 DATE 27.2.94 17.46';
  24.  
  25. VAR Win,win2: p_window;STATIC;
  26.     gadhilf:INTEGER;STATIC;
  27.     gad1,gad2,gad3,gad4,gad5:gadget;STATIC;
  28.     AktGad:^Gadget;STATIC;
  29.     ende,ende2,beenden2:BOOLEAN;
  30.     msg,msg2:^INTUIMESSAGE;STATIC;
  31.     titel,Undobuffer:STRING100;STATIC;
  32.     pfad,name:STRING100;STATIC;
  33.     fullpath:STRING[200];STATIC;
  34.     Textinfo:Stringinfo;STATIC;
  35.     t,LST:TEXT;STATIC;
  36.     s,s2:STRING[max];STATIC;
  37.     i:LONG;STATIC;
  38.     b:CHAR;STATIC;
  39.     text1,text3,text4,text5:INTUITEXT;STATIC;
  40.     gadget1,gadget2,gadget3:GADGET;STATIC;
  41.     itext1,itext2,itext3:INTUITEXT;STATIC;
  42.     aktuellgad:^GADGET;STATIC;
  43.     qual,j,yp,druckyx,druckyy:INTEGER;STATIC;
  44.     line:Long;STATIC;
  45.     mausan,ok:BOOLEAN;STATIC;
  46.     l,lauf:LONG;STATIC;
  47.     tatt:p_textattr;STATIC;
  48.     txtattr:textattr;
  49.  
  50.   PROCEDURE UniPrint(VAR win:p_Window; txt:STRING; c1,c2,x,y:INTEGER; shadow,
  51.                      center : BOOLEAN; tattr:p_TextAttr);
  52.   VAR
  53.     it,it1 : IntuiText;
  54.     l : LONG;
  55.   BEGIN
  56.     it := IntuiText(c1,0,JAM1,1,1,tattr,txt,^it1);
  57.     it1 := IntuiText(c2,0,JAM1,0,0,tattr,txt,NIL);
  58.     l := IntuiTextLength(^it)+1;
  59.     IF center THEN x := (win^.Width-l) DIV 2;
  60.     IF shadow THEN PrintIText(win^.RPort,^it,x,y)
  61.     ELSE PrintIText(win^.RPort,^it1,x,y);
  62.   END;
  63.  
  64.   PROCEDURE umrandung(wo:p_window,c1,c2,x,y,b,h:INTEGER);
  65.   TYPE
  66.     umrandungstyp=ARRAY[0..9] OF INTEGER;
  67.   VAR
  68.     Feld1,feld2:umrandungstyp;
  69.     border1,border2:BORDER;
  70.   BEGIN
  71.    feld1:=umrandungstyp(1,1,1,h-2,0,h-1,0,0,b-2,0);
  72.    feld2:=umrandungstyp(b-2,h-2,b-2,1,b-1,0,b-1,h-1,1,h-1);
  73.    Border1:=Border(x,y,c1,0,0,5,^Feld1,^Border2);
  74.    Border2:=Border(x,y,c2,0,0,5,^Feld2,Nil);
  75.    DrawBorder(wo^.rport,^Border1,0,0);
  76.   END;
  77.  
  78.   PROCEDURE gbord(wo:p_window,was:p_gadget);
  79.   BEGIN
  80.     umrandung(wo,2,1,was^.Leftedge,was^.Topedge,was^.Width,was^.height);
  81.   END;
  82.  
  83.   PROCEDURE newuline(wo:p_window,was:p_gadget,c:CHAR);
  84.   VAR
  85.     it:intuitext;STATIC;
  86.     x,y:LONG;STATIC;
  87.     stelle:INTEGER;
  88.    BEGIN
  89.      IF was^.Gadgettext<> NIL THEN
  90.      BEGIN
  91.        stelle:=POS(c,was^.gadgettext^.itext);
  92.        If stelle>0 THEN
  93.        BEGIN
  94.          stelle:=stelle-1;
  95.          x:=was^.Gadgettext^.leftedge+was^.Leftedge+8*stelle;
  96.          y:=was^.Gadgettext^.topedge+was^.Topedge+1;
  97.          it:=INTUITEXT(1,0,0,0,0,tatt,'_',NIL );
  98.          PRINTITEXT(wo^.rport,^it,x,y);
  99.        END;
  100.      END;
  101.    END;
  102.  
  103.   PROCEDURE newgbu(wo:p_window,was:p_gadget,c:CHAR);
  104.   BEGIN
  105.     gbord(wo,was);
  106.     newuline(wo,was,c);
  107.   END;
  108.  
  109. PROCEDURE hole_wbkram;        { sehr interessant ! 8-þ }
  110.  
  111. TYPE argarraytyp=^ARRAY[1..MaxInt] OF WBarg;
  112.  
  113.  VAR WBmsgPtr   : p_WBStartup;
  114.      p_argarray : argarraytyp;
  115.      hilfstr    : STRING[80];
  116.      dobj       : p_diskObject;
  117.      hilfi      : INTEGER;
  118.      vlock      : BPTR;
  119.  
  120. FUNCTION OpenIconLib:BOOLEAN;
  121.  BEGIN
  122.   IconBase:=NIL;
  123.   Iconbase:=OpenLibrary(ICONNAME,0);
  124.   IF IconBase=NIL THEN OpenIconLib:=FALSE ELSE OpenIconLib:=TRUE;
  125.  END;
  126.  
  127. PROCEDURE CloseIconLib;
  128.  BEGIN
  129.   IF IconBase<>NIL THEN CloseLibrary(IconBase);
  130.   IconBase:=NIL;
  131.  END;
  132.  
  133.  BEGIN
  134.   IF OpenIconLib THEN
  135.   BEGIN
  136.    WBmsgPtr:=StartupMessage;
  137.    p_argarray:=argarraytyp(wbmsgptr^.sm_ArgList);
  138.    Vlock:=currentdir(p_argarray^[1].wa_lock);
  139.    dobj:=Getdiskobject(p_argarray^[1].wa_Name);
  140.    IF (dobj<>NIL) THEN
  141.    BEGIN
  142.     hilfstr:=Findtooltype(dobj^.do_Tooltypes,'XCOORD');
  143.     IF hilfstr<>'' THEN
  144.      BEGIN
  145.       VAL(hilfstr,druckyx,hilfi);
  146.       IF hilfi<>0 THEN druckyx:=90;
  147.      END;
  148.     hilfstr:=Findtooltype(dobj^.do_Tooltypes,'YCOORD');
  149.     IF hilfstr<>'' THEN
  150.      BEGIN
  151.       VAL(hilfstr,druckyy,hilfi);
  152.       IF hilfi<>0 THEN druckyy:=46;
  153.      END;
  154.     hilfstr:=Findtooltype(dobj^.do_Tooltypes,'PFAD');
  155.     IF hilfstr<>'' THEN pfad:=hilfstr;
  156.     hilfstr:=Findtooltype(dobj^.do_Tooltypes,'MOUSEMOVE');
  157.     IF hilfstr='ON' THEN mausan:=TRUE;
  158.     FreeDiskObject(dobj);
  159.    END;
  160.  
  161.    IF (WBMsgPtr^.sm_NumArgs>1) THEN
  162.    BEGIN
  163.     pfad:='';
  164.     name:=p_argarray^[2].wa_Name;
  165.     Vlock:=currentdir(p_argarray^[2].wa_lock);
  166.    END;
  167.   END;
  168.   CloseIconLib;
  169.  END;
  170.  
  171. PROCEDURE meldung(was:STR);
  172.  BEGIN
  173.   setwindowtitles(win,str(-1),was);
  174.  END;
  175.  
  176. FUNCTION druckerok:BOOLEAN;     { Thanks to Diesel ! }
  177. CONST
  178.  PRA = $BFD000;  { * Basis-Addresse CIA-B * }
  179.  
  180. TYPE
  181.  BytePtr = ^Byte;
  182.  
  183. VAR
  184.  CIA_Byte : BytePtr;
  185.  CIA_Data : Byte;
  186.  
  187.  BEGIN
  188.   CIA_Byte := ptr(PRA);
  189.   CIA_Data := ( CIA_Byte^ ) MOD 4 ;
  190.   druckerok:=FALSE;
  191.  
  192.   CASE CIA_Data OF
  193.    3 : meldung("Der Drucker ist entweder aus oder offline und hat kein Papier mehr.");
  194.    1 : meldung("Der Drucker ist offline.");
  195.    2 : meldung("Der Drucker hat kein Papier mehr.");
  196.    0 : druckerok:=TRUE;
  197.   END;
  198.  END;
  199.  
  200.  
  201. PROCEDURE refresh;
  202.  BEGIN
  203.  Umrandung(win,1,2,97,16+yp,254,13);  {2 Umrandungen für stringgad }
  204.  Umrandung(win,2,1,95,15+yp,258,15);
  205.  newgbu(win,^gad1,'F');
  206.  newgbu(win,^gad3,'A');
  207.  newgbu(win,^gad4,'I');
  208.  newgbu(win,^gad5,'D');
  209.  END;
  210.  
  211.  FUNCTION abfrage(Abfragetitel:STR):BOOLEAN;
  212.   BEGIN
  213.    ok:=ModifyIDCMP(win,0);
  214.    win2:=open_window(184,105,272,45+yp,$0201,GADGETUP+GADGETDOWN+VANILLAKEY,
  215.                       ACTIVATE,abfragetitel,NIL,640,256,640,256);
  216.    uniprint(win2,'Wollen Sie das wirklich ???',1,2,30,15+yp,TRUE,FALSE,tatt);
  217.    Umrandung(win2,1,2,6,12+yp,260,14);
  218.    gadget1:=Gadget (^gadget2,6,27+yp,130,15,GADGHCOMP,RELVERIFY,
  219.                     BOOLGADGET,NIL,NIL,^itext1,0,NIL,13,NIL);
  220.    itext1:=INTUITEXT(1,0,0,25,3,tatt,'Ja (Return)',NIL);
  221.    newgbu(win2,^gadget1,'J');
  222.    gadget2:=Gadget (NIL,136,27+yp,130,15,GADGHCOMP,
  223.                     RELVERIFY,BOOLGADGET,NIL,NIL,^itext2,0,NIL,14,NIL);
  224.    itext2:=INTUITEXT(1,0,0,15,3,tatt,'Nein (Escape)',NIL);
  225.    newgbu(win2,^gadget2,'N');
  226.    gadhilf:=ADDGLIST(win2,^gadget1,0,-1,NIL);
  227.    REFRESHGLIST(^gadget1,win2,NIL,-1);
  228.    beenden2:=FALSE;
  229.    IF mausan THEN
  230.    BEGIN
  231.     IF OpenmouseposInput=TRUE THEN Positionmouse(80,33+yp,win2);
  232.     Closemouseposinput;
  233.    END;
  234.     REPEAT
  235.      msg2:=wait_port(win2^.Userport);
  236.      msg2:=GET_MSG(win2^.USERPORT);
  237.      CASE MSG2^.CLASS OF
  238.        VANILLAKEY:
  239.           CASE msg2^.code OF
  240.             106,74,13:
  241.              BEGIN
  242.               abfrage:=TRUE;{j,J,CR}
  243.               beenden2:=TRUE;
  244.              END
  245.             OTHERWISE
  246.              BEGIN
  247.               abfrage:=FALSE;
  248.               beenden2:=TRUE;
  249.              END;
  250.             END;
  251.  
  252.       GADGETUP:
  253.        BEGIN
  254.         AktuellGad:=Msg2^.IAddress;
  255.         Case AktuellGad^.GadgetID Of
  256.          13: BEGIN
  257.               abfrage:=TRUE;
  258.               beenden2:=TRUE;
  259.              END;
  260.          14: BEGIN
  261.               abfrage:=FALSE;
  262.               beenden2:=TRUE;
  263.              END;
  264.          OTHERWISE;
  265.         END;
  266.        END
  267.       ELSE;
  268.     END; {OF CASE}
  269.     reply_msg(msg2);
  270.    UNTIL beenden2;
  271.   gadhilf:=REMOVEGLIST(win2,^gadget1,-1);
  272.   close_window(win2);
  273.   ok:=ModifyIDCMP(win,VANILLAKEY+_CLOSEWINDOW+GADGETUP+GADGETDOWN);
  274.  END;
  275.  
  276.  
  277. PROCEDURE lesen;
  278.  
  279. PROCEDURE hcls;
  280.  BEGIN
  281.  SetApen(win2^.rport,0);
  282.  Rectfill(win2^.rport,0,0,640,240);
  283.  END;
  284.  
  285. PROCEDURE vorwaerts;
  286.  BEGIN
  287.   IF eof(t) THEN displaybeep(NIL)
  288.   ELSE
  289.   BEGIN
  290.    hcls;
  291.    j:=8;
  292.    WHILE (NOT (eof(t)) AND (j<230)) DO
  293.    BEGIN
  294.     inc(line);
  295.     read(t,s);
  296.     uniprint(win2,s,1,2,0,j,TRUE,FALSE,tatt);
  297.     j:=j+10;
  298.    END;
  299.   END; {OF else}
  300.  END;
  301.  
  302. PROCEDURE zurueck;
  303. VAR springer:LONG;
  304.  BEGIN
  305.   j:=8;
  306.   IF (line>23) THEN
  307.   BEGIN
  308.   Seek(t,0);      { An Dateianfang }
  309.   line:=line-46;
  310.   IF line<0 THEN line:=0;
  311.   FOR springer:=1 TO line DO read(t,s);
  312.   hcls;
  313.    WHILE (NOT (eof(t)) AND (j<230)) DO
  314.     BEGIN
  315.      inc(line);
  316.      read(t,s);
  317.      uniprint(win2,s,1,2,0,j,TRUE,FALSE,tatt);
  318.      j:=j+10;
  319.     END;
  320.   END ELSE Displaybeep(NIL); {Dateianfang}
  321. END;
  322.  
  323.  
  324.  BEGIN
  325.   meldung('');
  326.   fullpath:=pfad+name;
  327.   RESET(t,fullpath);
  328.   IF (IORESULT<>0) THEN
  329.    BEGIN
  330.     displaybeep(NIL);        {Datei nicht vorhanden !!!}
  331.     meldung('FEHLER: Datei nicht vorhanden');
  332.     exit;
  333.    END
  334.    ELSE
  335.     BEGIN
  336.      buffer(t,10000);
  337.      j:=8;
  338.      line:=0;
  339.      beenden2:=FALSE;
  340.      win2:=open_window(0,0,640,256,$0201,GADGETUP+GADGETDOWN+RAWKEY,
  341.                        BORDERLESS+ACTIVATE,'',NIL,640,256,640,256);
  342.      hcls;
  343.      gadget1:=Gadget (^gadget2,2,241,212,15,GADGHCOMP,RELVERIFY,
  344.              BOOLGADGET,NIL,NIL,^itext1,0,NIL,13,NIL);
  345.      itext1:=INTUITEXT(1,0,0,15,3,tatt,'Vorwärts (Cursor Down)',NIL);
  346.      newgbu(win2,^gadget1,'V');
  347.      gadget2:=Gadget (^gadget3,214,241,212,15,GADGHCOMP,
  348.               RELVERIFY,BOOLGADGET,NIL,NIL,^itext2,0,NIL,14,NIL);
  349.      itext2:=INTUITEXT(1,0,0,25,3,tatt,'Rückwärts (Cursor up)',NIL);
  350.      newgbu(win2,^gadget2,'R');
  351.      gadget3:=Gadget (NIL,426,241,212,15,GADGHCOMP,RELVERIFY,
  352.              BOOLGADGET,NIL,NIL,^itext3,0,NIL,15,NIL);
  353.      itext3:=INTUITEXT(1,0,0,45,3,tatt,'Hauptmenü (Esc)',NIL);
  354.      newgbu(win2,^gadget3,'H');
  355.  
  356.      gadhilf:=ADDGLIST(win2,^gadget1,0,-1,NIL);
  357.  
  358.      REFRESHGLIST(^gadget1,win2,NIL,-1);
  359.      WHILE (NOT eof(t) AND (j<230)) DO
  360.      BEGIN
  361.       inc(line);
  362.       read(t,s);
  363.       uniprint(win2,s,1,2,0,j,TRUE,FALSE,tatt);
  364.       j:=j+10;
  365.      END;
  366.      REPEAT
  367.       msg2:=wait_port(win2^.Userport);
  368.       msg2:=GET_MSG(win2^.USERPORT);
  369.       qual:=msg2^.qualifier;
  370.        CASE MSG2^.CLASS OF
  371.          RAWKEY:
  372.           BEGIN
  373.           IF qual= -32768 THEN
  374.             CASE msg2^.code OF
  375.               52,64,77,68:vorwaerts; {v,CURSOR-down,Space,CR}
  376.               76,19:zurueck;{ Cursor-up, R}
  377.               69,37:beenden2:=TRUE  { Esc,H }
  378.               OTHERWISE END;
  379.           END;
  380.  
  381.          GADGETUP:
  382.           BEGIN
  383.            AktuellGad:=Msg2^.IAddress;
  384.            Case AktuellGad^.GadgetID Of
  385.             13: vorwaerts;
  386.             14: zurueck;
  387.             15: beenden2:=TRUE;
  388.             OTHERWISE;
  389.            END;
  390.           END
  391.          ELSE;
  392.        END; {OF CASE}
  393.        reply_msg(msg2);
  394.         UNTIL beenden2;
  395.         close(t);
  396.      END;  {OF ELSE}
  397.     gadhilf:=REMOVEGLIST(win2,^gadget1,-1);
  398.     close_window(win2);
  399.  END;
  400.  
  401. PROCEDURE rinfo;
  402.  VAR win3:p_window;
  403.      gad12:GADGET;
  404.      text12c:INTUITEXT;
  405.      msg3:^INTUIMESSAGE;
  406.  BEGIN
  407.   ok:=ModifyIDCMP(win,0);
  408.   meldung('');
  409.   win3:=open_window(90,46,450,175+yp,$0201,GADGETUP+GADGETDOWN+VANILLAKEY,
  410.                 ACTIVATE,' Drucky V2.4 INFOFENSTER',NIL,640,256,640,256);
  411.   gad12:=GADGET(NIL,0,0,450,175+yp,GADghnone,GADGIMMEDIATE,BOOLGADGET,
  412.                 NIL,NIL,NIL,0,NIL,14,NIL);
  413.   uniprint(win3,'DRUCKY V2.4  ist Public Domain',2,1,0,15+yp,TRUE,TRUE,tatt);
  414.   uniprint(win3,'Du kannst es also benutzen, kopieren, verändern ...',1,2,0,25+yp,TRUE,TRUE,tatt);
  415.   uniprint(win3,'Allerdings muß erwähnt werden, daß die Originalversion',1,2,0,35+yp,TRUE,TRUE,tatt);
  416.   uniprint(win3,'von mir stammt und es muß meine Adresse mit drinstehen',1,2,0,45+yp,TRUE,TRUE,tatt);
  417.   uniprint(win3,'mit dem Aufruf, mir eigene Pascalprogramme und',1,2,0,55+yp,TRUE,TRUE,tatt);
  418.   uniprint(win3,'Sourcecodes zu schicken.',1,2,0,65+yp,TRUE,TRUE,tatt);
  419.   uniprint(win3,'Wenn Du Vorschläge zur Verbesserung hast, schicke doch',1,2,0,75+yp,TRUE,TRUE,tatt);
  420.   uniprint(win3,'einfach eine Diskette mit Routinen oder auch anderen',1,2,0,85+yp,TRUE,TRUE,tatt);
  421.   uniprint(win3,'eigenen Pascal oder PD  Programmen/Sourcecodes an:',1,2,0,95+yp,TRUE,TRUE,tatt);
  422.   uniprint(win3,'                     Røgersøft',3,2,8,107+yp,TRUE,FALSE,tatt);
  423.   uniprint(win3,'                     Michael Klein',3,2,8,117+yp,TRUE,FALSE,tatt);
  424.   uniprint(win3,'                     Am Wasserturm 6',3,2,8,127+yp,TRUE,FALSE,tatt);
  425.   uniprint(win3,'            GERMANY  67346 Speyer',3,2,8,137+yp,TRUE,FALSE,tatt);
  426.   uniprint(win3,'Erstellt mit KICK-Pascal V2.1 von MAXON Computer',1,2,8,150+yp,TRUE,TRUE,tatt);
  427.   uniprint(win3,'Besonderen Dank an Bombersoft und Diesel !',1,3,0,160+yp,TRUE,TRUE,tatt);
  428.   gadhilf:=ADDGADGET(win3,^GAD12,0);
  429.   REFRESHGADGETS(win3^.firstgadget,win3,NIL);
  430.   msg3:=Wait_port(Win3^.Userport);
  431.   msg3:=get_msg(win3^.userport);
  432.   reply_msg(msg3);
  433.   close_window(win3);
  434.   ok:=ModifyIDCMP(win,VANILLAKEY+_CLOSEWINDOW+GADGETUP+GADGETDOWN);
  435.  END;
  436.  
  437.  
  438. PROCEDURE pbalken(max,zaehler:LONG);
  439.  Var hilfstring:STRING[6];
  440.      y2:LONG;
  441.      zprozent,z1,z2:INTEGER;
  442.      einprozent:REAL;
  443.  
  444. BEGIN
  445.  setapen(win2^.rport,3);
  446.  zprozent:=round(zaehler/(max/100));
  447.  y2:=17+(zprozent SHL 2);
  448.  rectfill(win2^.rport,17,16+yp,y2,33+yp);
  449.  setapen(win2^.rport,1);
  450.  Move(win2^.rport,210,45+yp);
  451.  hilfstring:=intstr(zprozent);
  452.  hilfstring:=hilfstring+' %';
  453.  l:=_text(win2^.rport,hilfstring,Length(hilfstring));
  454. END;
  455.  
  456. PROCEDURE oeffne_Fenster;
  457. BEGIN
  458.  win2:=Open_Window(110,80,430,52+yp,$0201,_Closewindow,Windowclose+WINDOWDRAG+WINDOWDEPTH,
  459.                    'Drucky V2.4: Text drucken',NIL,0,0,640,255);
  460.  umrandung(win2,2,1,15,15+yp,404,20);
  461.  IF mausan THEN
  462.  BEGIN
  463.   IF OpenmouseposInput=TRUE THEN Positionmouse(10,5,win2);
  464.   Closemouseposinput;
  465.  END;
  466. END;
  467.  
  468. PROCEDURE schliesse_Fenster;
  469. BEGIN
  470.  IF win2<>NIL THEN close_window(win2);
  471. END;
  472.  
  473.  
  474. PROCEDURE druck;
  475.  VAR groesse,Position,anf:LONG;
  476.      zeilenlaenge:INTEGER;
  477.  
  478.  BEGIN
  479.   assign(LST,'prt:');
  480.   rewrite(LST);
  481.   groesse:=filesize(t);               { Dateigröße feststellen}
  482.   Position:=0;
  483.   msg2:=NIL;
  484.   oeffne_Fenster;
  485.   WHILE NOT eof(t) DO
  486.    BEGIN
  487.     readln(t,s);
  488.     zeilenlaenge:=length(s);
  489.     Position:=position+zeilenlaenge;
  490.     inc(position);
  491.     anf:=pos('§',s);
  492.     IF anf<>0 THEN
  493.     BEGIN
  494.     write(lst,Copy(s,1,anf-1));
  495.      FOR i:=anf TO zeilenlaenge DO
  496.      BEGIN                              { Stringbearbeitung }
  497.        IF s[i]='§' THEN
  498.        BEGIN                            {SONDERZEICHENBEARBEITUNG}
  499.         inc(i);
  500.         b:=s[i];
  501.         inc(i);
  502.         CASE b OF
  503.          'K' : write(lst,CHR(27),'[3m');    { kursiv ein          }
  504.          'k' : write(lst,CHR(27),'[23m');   { kursiv aus          }
  505.          'U' : write(lst,CHR(27),'[4m');    { unterstreichen ein  }
  506.          'u' : write(lst,CHR(27),'[24m');   { unterstreichen aus  }
  507.          'F' : write(lst,CHR(27),'[1m');    { Fettschrift ein     }
  508.          'f' : write(lst,CHR(27),'[22m');   { Fettschrift aus     }
  509.          'E' : write(lst,CHR(27),'[2w');    { Elite ein           }
  510.          'e' : write(lst,CHR(27),'[1w');    { Elite aus           }
  511.          'C' : write(lst,CHR(27),'[4w');    { Condensed ein       }
  512.          'c' : write(lst,CHR(27),'[3w');    { Condensed aus       }
  513.          'B' : write(lst,CHR(27),'[6w');    { Breitschrift ein    }
  514.          'b' : write(lst,CHR(27),'[5w');    { Breitschrift aus    }
  515.          'S' : write(lst,CHR(27),'[6"z');   { Schattenschrift ein }
  516.          's' : write(lst,CHR(27),'[5"z');   { Schattenschrift aus }
  517.          'N' : write(lst,CHR(27),'[2"z');   { NLQ ein             }
  518.          'n' : write(lst,CHR(27),'[1"z');   { NLQ aus             }
  519.          'H' : write(lst,CHR(27),'[2v');    { hochsetzen ein      }
  520.          'h' : write(lst,CHR(27),'[1v');    { hochsetzen aus      }
  521.          'T' : write(lst,CHR(27),'[4v');    { tiefsetzen ein      }
  522.          't' : write(lst,CHR(27),'[3v');    { tiefsetzen aus      }
  523.         ELSE
  524.         END;                   { OF CASE }
  525.        END;                    { OF SONDERZEICHEN }
  526.        IF (s[i]<>'§') AND (i<length(s)+1) THEN write(LST,s[i]) ELSE dec(i);
  527.      END;                     {OF STRINGBEARBEITUNG}
  528.     write(lst,chr(10));
  529.     END
  530.     ELSE writeln(lst,s);
  531.     pbalken(groesse,position);
  532.     IF msg2=NIL THEN msg2:=get_msg(win2^.Userport)
  533.     ELSE
  534.     IF msg2^.class=_CloseWindow THEN
  535.      BEGIN
  536.       close(lst);
  537.       close(t);
  538.       Reply_Msg(Msg2);
  539.       schliesse_Fenster;
  540.       exit;
  541.      END
  542.      ELSE
  543.      Reply_Msg(Msg2);
  544.    END;                      {OF WHILE}
  545.    close(lst);
  546.    close(t);
  547.    schliesse_Fenster;
  548.  END;   {OF DRUCK}
  549.  
  550.  PROCEDURE drucken;
  551.   BEGIN
  552.    ok:=ModifyIDCMP(win,0);
  553.    fullpath:=pfad+name;
  554.    RESET(t,fullpath);
  555.    IF (ioresult=0) THEN
  556.     BEGIN
  557.     IF druckerok THEN
  558.      BEGIN
  559.       buffer(t,10000);
  560.       druck;
  561.       meldung('MELDUNG: DRUCKEN BEENDET');
  562.      END ELSE close(t);
  563.     END
  564.    ELSE
  565.     BEGIN
  566.      meldung('FEHLER: Datei nicht vorhanden');
  567.     END;
  568.   ok:=ModifyIDCMP(win,VANILLAKEY+_CLOSEWINDOW+GADGETUP+GADGETDOWN);
  569.   END;
  570.  
  571. PROCEDURE requester;
  572.  BEGIN
  573.   meldung('');
  574.   IF req('Drucky V2.4: Datei auswählen',name,pfad,win)
  575.   THEN
  576.   BEGIN
  577.    fullpath:=pfad+name;
  578.    refreshgadgets(^gad2,win,NIL);
  579.   END;
  580.  END;
  581.  
  582. PROCEDURE hauptprogramm;
  583.  BEGIN
  584.  druckyx:=90;
  585.  druckyy:=46;
  586.  mausan:=FALSE;
  587.  pfad:='';
  588.  name:='';
  589.  IF FromWB THEN hole_wbkram;
  590.  fullpath:=name;
  591.  Undobuffer:='';
  592.  txtattr:=Textattr('topaz.font',8,0,0);
  593.  tatt:=^txtattr;
  594.  Win:=open_window(0,0,1,1,1,0,0,NIL,NIL,0,0,0,0);
  595.  yp:=win^.WScreen^.font^.ta_Ysize-8;
  596.  close_window(win);
  597.  Win:=Open_Window(druckyx,druckyy,364,50+yp,$0201,VANILLAKEY+_CLOSEWINDOW+GADGETUP+GADGETDOWN,
  598.         WINDOWDRAG+WINDOWDEPTH+WINDOWCLOSE+ACTIVATE,
  599.         'Drucky V2.4 Final Version - PD -',Nil,640,255,640,255);
  600.  
  601.  gad1:=Gadget(^gad2,10,15+yp,85,15,GADGHCOMP,RELVERIFY,BOOLGADGET,
  602.               NIL,NIL,^text1,0,NIL,1,NIL);
  603.  gad2:=Gadget(^gad3,100,19+yp,248,8,GADGHCOMP,RELVERIFY,
  604.               STRGADGET,NIL,NIL,NIL,0,^Textinfo,2,NIL);
  605.  gad3:=Gadget(^gad4,10,30+yp,120,15,GADGHCOMP,RELVERIFY,BOOLGADGET,
  606.               NIL,NIL,^text3,0,NIL,3,NIL);
  607.  gad4:=Gadget(^gad5,130,30+yp,103,15,GADGHCOMP,RELVERIFY,BOOLGADGET,
  608.               NIL,NIL,^text4,0,NIL,4,NIL);
  609.  gad5:=Gadget(NIL,233,30+yp,120,15,GADGHCOMP,RELVERIFY,BOOLGADGET,
  610.               NIL,NIL,^text5,0,NIL,5,NIL);
  611.  
  612.  text1:=INTUITEXT(1,0,0,12,3,tatt,'Filename',NIL);
  613.  text3:=INTUITEXT(1,0,0,30,3,tatt,'Anzeigen',NIL);
  614.  text4:=INTUITEXT(1,0,0,35,3,tatt,'Info',NIL);
  615.  text5:=INTUITEXT(1,0,0,35,3,tatt,'Drucken',NIL);
  616.  gadhilf:=ADDGLIST(win,^gad1,0,-1,NIL);
  617.  
  618.  Textinfo:=Stringinfo(^fullpath,^Undobuffer,0,80,0,0,0,0,0,0,NIL,0,NIL);
  619.  
  620.  refresh;                     { Border für Gadgets zeichnen }
  621.  
  622.  REFRESHGLIST(^gad1,Win,NIL,-1);
  623.    Ende:=FALSE;
  624.    REPEAT
  625.      Msg:=Wait_Port(Win^.UserPort);
  626.      Msg:=Get_Msg(Win^.UserPort);
  627.      Case Msg^.Class Of
  628.        _CLOSEWINDOW: IF abfrage('Drucky V2.4 beenden ?')
  629.                      THEN ende:=TRUE;
  630.  
  631.        GADGETUP,GADGETDOWN:
  632.                 Begin
  633.                   AktGad:=Msg^.IAddress;
  634.                   Case AktGad^.GadgetID Of
  635.                    1: Requester;
  636.                    2: BEGIN
  637.                        pfad:='';
  638.                        name:=fullpath;
  639.                       END;
  640.                    3: lesen;
  641.                    4: rinfo;
  642.                    5: drucken;
  643.                   Otherwise;
  644.                   End  { inneres CASE }
  645.                 End;
  646.        VANILLAKEY:
  647.           CASE msg^.code OF
  648.              102,70:OK:=activategadget(^gad2,win,NIL);
  649.               97,65:lesen;
  650.               105,73:rinfo;
  651.               27,113,81: IF abfrage('Drucky V2.4 beenden ?')
  652.                      THEN ende:=TRUE;
  653.               114,82:Requester;     {r,R}
  654.               100,68: drucken
  655.             OTHERWISE;
  656.             END;
  657.          Otherwise;
  658.       End;  { inneres CASE }
  659.      Reply_Msg(Msg);
  660.    UNTIL Ende;
  661.   gadhilf:=REMOVEGLIST(win,^gad1,-1);
  662.   Close_Window(Win);
  663.  END;
  664.  
  665. PROCEDURE vom_cli;
  666. Begin
  667.  fullpath:=parameterstr;
  668.  fullpath[parameterlen]:=chr(0);
  669.  IF fullpath='' THEN hauptprogramm
  670.   ELSE
  671.    BEGIN
  672.     RESET(t,fullpath);
  673.     IF (ioresult<>0) THEN
  674.      BEGIN
  675.       writeln('SORRY !!! Datei nicht vorhanden !!!');
  676.      END
  677.      ELSE
  678.     druck;
  679.    END;
  680.   END;
  681.  
  682. {*********************** MAIN *****************}
  683.  
  684. BEGIN
  685. If fromwb THEN hauptprogramm
  686.           ELSE vom_CLI;
  687. END.
  688.